home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / tiptrix / LISTING3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-09-17  |  1.4 KB  |  56 lines
  1. unit ClassPlug;
  2.  
  3. interface
  4.  
  5. procedure ReplaceParentClass( DClass, OldParent, NewParent: TClass);
  6.  
  7. implementation
  8.  
  9. uses
  10.   Windows;
  11.  
  12. type
  13.   PP = ^Pointer; // Pointer of Pointer of Parent...
  14.  
  15. procedure ReplaceParentClass( DClass, OldParent, NewParent: TClass);
  16. var
  17.   a: ^Byte;
  18.   p1,p2: PP;
  19.   prot: Longint;
  20. begin
  21.   // Simple dummy check..
  22.   if ( NewParent = nil ) or ( DClass = nil ) then Exit;
  23.  
  24.   // Find the class Parent pointer of AClass
  25.   while ( DClass.ClassParent <> OldParent ) do begin
  26.     if DClass.ClassParent = nil then Exit;
  27.     if DClass.ClassParent = NewParent then Exit;
  28.     DClass := DClass.ClassParent;
  29.   end;
  30.  
  31.   a := Pointer(DClass);
  32.   inc(a,vmtParent);
  33.   p1 := Pointer(a);
  34.  
  35.   // Find the class Self pointer of NewParent, wich will be used to
  36.   // fill the place of the ParentClass Pointer...
  37.   // (this is also quite basic...)
  38.   a := Pointer(NewParent);
  39.   inc(a,vmtSelfPtr);
  40.   p2 := Pointer(a);
  41.  
  42.   // Big THANX to Cyril Jandia for the next 3 steps...
  43.   // Taken from the DMZ #24 class traps example...
  44.   // I had it all worked out, except for the VirtualProtect thingy..
  45.  
  46.   VirtualProtect(p1, SizeOf(Pointer), PAGE_READWRITE, @prot); // let's be brave
  47.   p1^ := p2; // let's be yet more brave
  48.   // time to be clean: not necessary but easy to do, then...
  49.   VirtualProtect(P1, SizeOf(Pointer), prot, @prot);
  50.  
  51. // use the next line to visualize the change...
  52. // TClass(PP(P1)^^).className
  53. end;
  54.  
  55. end.
  56.